home *** CD-ROM | disk | FTP | other *** search
/ CD Classic / CD CLASSIC #1.iso / 3df / 3df.pas < prev    next >
Pascal/Delphi Source File  |  1991-04-20  |  14KB  |  472 lines
  1. { 3dF --- Simple viewer for real functions of form F(x,y).  }
  2. { Parse an expression to form a syntax tree.  Walk the tree }
  3. { to evaluate the expression on a grid over the x-y plane.  }
  4. { Draw orthographic projection with hidden lines removed,   }
  5. { view angle, etc. adjustable by user with cursor controls. }
  6. { Disclaimer:  This code is a mess.  It was written in a    }
  7. { very short time to prove that expensive hardware was not  }
  8. { required for a specific purpose.  Let the user beware.    }
  9.  
  10. { Compile with TP 5.0. }
  11.  
  12. Program p3dF;
  13. Uses Crt, Parse;
  14.  
  15. { Assembly language assist.  According to tprof, most
  16.   opportunity for getting faster is in DrawLine,
  17.   especially Plot (on my 4.77Mhz 8088 w/o NCP). }
  18. procedure SetVideo(mode: Byte); external;
  19. procedure ClearScreen; external;
  20. procedure SetPallette(pal: Byte); external;
  21. procedure SetBackGround(color: Byte); external;
  22. procedure MovePen(x, y: Word); external;
  23. procedure DrawLine(x, y: Word); external;
  24. procedure InitCloud; external;
  25. procedure UpdateCloud; external;
  26. procedure ClearImage; external;
  27. procedure ShowImage; external;
  28. {$ifdef profile}
  29. procedure initx; external;
  30. procedure inity; external;
  31. procedure initXinc; external;
  32. procedure initYinc; external;
  33. procedure plot; external;
  34. {$endif}
  35. {$L 3df.obj}
  36.  
  37. const
  38.   nGrids = 15;      { make me 10 for faster displays of fewer grids }
  39.   DevP = 192;       { vertical device size in pixels }
  40.   StepsInQuad = 18;
  41.   IntScale = 32;
  42.   ScaleBits = 5;
  43.   ScaleBitsM1 = 4;  { scale bits minus 1 (accounts for 2/1 aspect of pixels) }
  44.   pi = 3.1415926535897932385;  { Save fun call time. }
  45. var
  46.   eData: array[-nGrids..nGrids, -nGrids..nGrids] of Real;
  47.   eMin, eMax: Real;
  48.   yData: array[0..3, -nGrids..nGrids, -nGrids..nGrids] of Integer;
  49.   scrImg: array[0..199, 0..79] of Byte;
  50.   baseXTbl,
  51.   baseYTbl,
  52.   deltaXiTbl,
  53.   deltaYiTbl,
  54.   deltaXjTbl,                                    { how much to inc x for step in j }
  55.   deltaYjTbl: array[0..StepsInQuad] of Integer;  { how much to inc y for step in j }
  56.  
  57. procedure FillGrid(size, exag: Real; phi: Integer);
  58. var
  59.   e, de, i, j: Integer;
  60.   sPhi, cPhi,
  61.   imageHt, imageWd,
  62.   unitsToDev, eScale,
  63.   theta, dTheta, sTheta, cTheta, sizeP, scaleFac: Real;
  64. begin
  65.   sPhi := Sin(phi*pi/180);
  66.   cPhi := Cos(phi*pi/180);
  67.   { 1.5 is really sqrt(2)*fudge to _ensure_ images lie in screen. }
  68.   imageHt := sPhi*size*1.5+cPhi*(eMax-eMin)*exag;
  69.   imageWd := size*1.5;
  70.   if imageHt > imageWd/1.6 then
  71.     unitsToDev := DevP/imageHt
  72.   else
  73.     unitsToDev := DevP*1.6/imageWd;
  74.   sizeP := size*unitsToDev;
  75.   eScale := exag*unitsToDev*cPhi*IntScale;
  76.   for i := -nGrids to nGrids do
  77.     for j := -nGrids to nGrids do begin
  78.       e := Round((eData[i,j]-eMin)*eScale);
  79.       yData[0, i, j] := e;
  80.       yData[1, j,-i] := e;
  81.       yData[2, -i,-j] := e;
  82.       yData[3, -j, i] := e;
  83.     end;
  84.   theta := 0;
  85.   dTheta := (pi/2)/StepsInQuad;
  86.   scaleFac := sizeP/(nGrids+nGrids)*IntScale;
  87.   for i := 0 to stepsInQuad-1 do begin
  88.     sTheta := scaleFac*Sin(theta);
  89.     cTheta := scaleFac*Cos(theta);
  90.     deltaXiTbl[i] := Round(sTheta);
  91.     deltaYiTbl[i] := Round(cTheta*sPhi);
  92.     deltaXjTbl[i] := Round(cTheta);
  93.     deltaYjTbl[i] := Round(sTheta*sPhi);
  94.     baseXtbl[i] := Round((sizeP*0.707*Cos(theta+pi/4)+160)*IntScale);
  95.     baseYtbl[i] := Round((DevP-sizeP*0.707*(1-Sin(theta+pi/4))*sPhi)*IntScale);
  96.     theta := theta+dTheta;
  97.   end;
  98. end;
  99.  
  100. procedure DrawIt(cx, cy, size: Real);
  101. const
  102.   initStep = 4;
  103.   initDstep = 1;
  104.   initQuad = 1;
  105.   initPhi = 20;
  106.   initExag = 1;
  107. var
  108.   exag: Real;
  109.   i, j, phi,
  110.   step, quad, dStep, x00, y00, x0, y0, x, y, tx, ty,
  111.   px, py0, py, lastPx, lastPy0, dxi, dyi, dxj, dyj: Integer;
  112.   lastCutX, lastCutY: array[-nGrids..nGrids] of Integer;
  113.   ch: Char;
  114.  
  115.   procedure WritePhi;
  116.   begin
  117.     GoToXY(19, 25);
  118.     Write(phi:2);
  119.   end;
  120.  
  121.   procedure WriteExag;
  122.   begin
  123.     GoToXY(36, 25);
  124.     Write(exag:3:1);
  125.   end;
  126.  
  127. begin
  128.   DirectVideo := False;
  129.   dStep := initDstep;
  130.   step := initStep;
  131.   quad := initQuad;
  132.   phi := initPhi;
  133.   exag := initExag;
  134.   FillGrid(size, exag, phi);
  135.   SetVideo(6);  { 640 x 200 }
  136.   ClearScreen;
  137.   GoToXY(1, 25);
  138.   Write(
  139.     'eXit '#27#26'rot '#24#25'elev(__) PgUp/Dn exag(___) ',
  140.     'x ',cx:0:2, ' y ', cy:0:2, ' sz ', size:0:2,
  141.     ' f ', eMin:0:2, '/', eMax:0:2);
  142.   WritePhi;
  143.   WriteExag;
  144.   repeat
  145.     ClearImage;
  146.     InitCloud;
  147.     x0 := baseXtbl[step];
  148.     x00 := x0;
  149.     y0 := baseYtbl[step];
  150.     y00 := y0;
  151.     dxi := deltaXiTbl[step];
  152.     dyi := deltaYiTbl[step];
  153.     dxj := deltaXjTbl[step];
  154.     dyj := deltaYjTbl[step];
  155.     { draw first cut }
  156.     y := y0;
  157.     x := x0;
  158.     px := x shr ScaleBitsM1;
  159.     py0 := y shr ScaleBits;
  160.     py := (y-yData[quad, -nGrids,-nGrids]) shr ScaleBits;
  161.     MovePen(px, py0);
  162.     DrawLine(px, py);
  163.     lastPx := px;
  164.     lastPy0 := py0;
  165.     lastCutX[-nGrids] := px;
  166.     lastCutY[-nGrids] := py;
  167.     for j := -nGrids+1 to nGrids do begin
  168.       x := x - dxj;
  169.       y := y - dyj;
  170.       px := x shr ScaleBitsM1;
  171.       py0 := y shr ScaleBits;
  172.       py := (y-yData[quad, -nGrids, j]) shr ScaleBits;
  173.       DrawLine(px, py);
  174.       DrawLine(px, py0);
  175.       MovePen(lastPx, lastPy0);
  176.       DrawLine(px, py0);
  177.       if j = 0 then
  178.         if Odd(quad) then begin
  179.           tx := x-dxi*3;
  180.           ty := y+dyi*3;
  181.           DrawLine(tx shr ScaleBitsM1, ty shr ScaleBits);
  182.           if quad = 1 then begin
  183.             DrawLine((tx-dxi+dxj) shr ScaleBitsM1,
  184.              (ty+dyi+dyj) shr ScaleBits);
  185.             MovePen(tx shr ScaleBitsM1, ty shr ScaleBits);
  186.             DrawLine((tx-dxi-dxj) shr ScaleBitsM1,
  187.              (ty+dyi-dyj) shr ScaleBits);
  188.           end
  189.           else begin
  190.             DrawLine((tx+dxi+dxj) shr ScaleBitsM1,
  191.              (ty-dyi+dyj) shr ScaleBits);
  192.             MovePen(tx shr ScaleBitsM1, ty shr ScaleBits);
  193.             DrawLine((tx+dxi-dxj) shr ScaleBitsM1,
  194.              (ty-dyi-dyj) shr ScaleBits);
  195.           end;
  196.         end;
  197.       MovePen(px, py);
  198.       lastPx := px;
  199.       lastPy0 := py0;
  200.       lastCutX[j] := px;
  201.       lastCutY[j] := py;
  202.     end;
  203.     UpdateCloud;
  204.     lastPx := x00 shr ScaleBitsM1;
  205.     lastPy0 := y00 shr ScaleBits;
  206.     for i := -nGrids+1 to nGrids do begin
  207.       x0 := x0+dxi;
  208.       y0 := y0-dyi;
  209.       y := y0;
  210.       x := x0;
  211.       px := x shr ScaleBitsM1;
  212.       py0 := y shr ScaleBits;
  213.       py := (y-yData[quad, i,-nGrids]) shr ScaleBits;
  214.       MovePen(lastPx, lastPy0);
  215.       DrawLine(px, py0);
  216.       lastPx := px;
  217.       lastPy0 := py0;
  218.       if (i = 0) and (quad and 1 = 0) then begin
  219.         tx := x+dxj*3;
  220.         ty := y+dyj*3;
  221.         MovePen(tx shr ScaleBitsM1, ty shr ScaleBits);
  222.         if quad = 0 then begin
  223.           DrawLine((tx+dxj-dxi) shr ScaleBitsM1,
  224.             (ty+dyj+dyi) shr ScaleBits);
  225.           MovePen(tx shr ScaleBitsM1, ty shr ScaleBits);
  226.           DrawLine((tx+dxj+dxi) shr ScaleBitsM1,
  227.             (ty+dyj-dyi) shr ScaleBits);
  228.         end
  229.         else begin
  230.           DrawLine((tx-dxj-dxi) shr ScaleBitsM1,
  231.             (ty-dyj+dyi) shr ScaleBits);
  232.           MovePen(tx shr ScaleBitsM1, ty shr ScaleBits);
  233.           DrawLine((tx-dxj+dxi) shr ScaleBitsM1,
  234.             (ty-dyj-dyi) shr ScaleBits);
  235.         end;
  236.         MovePen(tx shr ScaleBitsM1, ty shr ScaleBits);
  237.         DrawLine(px, py0);
  238.       end;
  239.       DrawLine(px, py);
  240.       DrawLine(lastCutX[-nGrids], lastCutY[-nGrids]);
  241.       UpdateCloud;
  242.       MovePen(px, py);
  243.       lastCutX[-nGrids] := px;
  244.       lastCutY[-nGrids] := py;
  245.       for j := -nGrids+1 to nGrids do begin
  246.         x := x - dxj;
  247.         y := y - dyj;
  248.         px := x shr ScaleBitsM1;
  249.         py := (y-yData[quad, i, j]) shr ScaleBits;
  250.         DrawLine(px, py);
  251.         DrawLine(lastCutX[j], lastCutY[j]);
  252.         MovePen(px, py);
  253.         lastCutX[j] := px;
  254.         lastCutY[j] := py;
  255.         UpdateCloud;
  256.       end;
  257.     end;
  258.     if KeyPressed then begin
  259.       ch := ReadKey;
  260.       if ch = #0 then begin
  261.         ch := ReadKey;
  262.         case ch of
  263.         #77: if dStep > -3 then         { right arrow }
  264.                dStep := dStep-1;
  265.         #75